;; introducing the namespace shen.primitives which consists of the KLambda macros
;; :only (*clojure-version* *in* *err* *out*) is used here, so no clojure macros or functions are used by accident
(ns shen.primitives
  (:refer-clojure 
		:only (*clojure-version* *in* *err* *out* fn))
  (:require [clojure.test :as test] 
		[clojure.java.io :as io] 
		[clojure.string :as string]
		[clojure.walk :as walk])
  (:use clojure.tools.trace)
  (:import [java.util.regex Pattern]))

;; alias for the clojure.core namespace, for better readability
(clojure.core/alias 'cl 'clojure.core)


;; Here the arguments have to be checked to be true or false, since only these are accepted as booleans in Shen/KLambda
;; everything else works as in Clojure
;;checking if a expr is a boolean, e.g true or false (helpfunction, not part of KLambda)
(cl/defn clj-boolean? [expr] (cl/or (cl/isa? expr true) (cl/isa? expr false)))

;;; Assignments (2) --DONE--
;;; Symbols in Shen correspond to Vars in Clojure: they evaluate to themselves
;; The variables are created in a different namespace shen.vars
;; to solve the dual namespace problem in Shen

;; creating a namespace for the variables used (dual namespace behaviour)
(cl/create-ns 'shen.vars)

;; set is defined as a function, because of the evaluation of symbols.
(cl/defmacro set
  [x y]
  (cl/let [x (cl/with-meta x {:dynamic true})]
  (if (cl/not (cl/seq? x)) (cl/eval `(cl/defonce ~x '~x)))
  `(cl/let [meta# 
            {:dynamic true :declared true}
            y# ~y
            x# ~x]
           (if (cl/symbol? x#)
             (cl/intern (cl/the-ns 'shen.vars) x# y#)
             (cl/intern (cl/the-ns 'shen.vars) '~x y#)) 
           y#)))

;; value receives the value of a given shen variable by searching the corresponding variable in the shen.vars namespace and resolving it.
(cl/defmacro value [x] 
  (if (clj-boolean? x) x
	`(cl/let [s# (cl/symbol (cl/str "shen.vars/" (cl/name (if (cl/seq? '~x) (cl/eval '~x) '~x))))]
				(if (cl/resolve s#)
					(cl/eval s#)
					(throw (Exception. (cl/str "variable " '~x " has no value.")))))))



;;; Boolean Operations (4) --DONE--
;; if you don't use (shen-repl) or (run-shen) you have to call shen.primitives/if explicitly instead of if.
;; currently the special form if is used due to problems with method sizes.
;(cl/defmacro if 
;	([x] `(fn [y# z#] (shen.primitives/if '~x y# z#)))
;	([x y] `(if (clj-boolean? ~x) (if ~x ~y) (throw (Exception. (cl/str ~x " is not a boolean.")))))
;	([x y z] `(if (clj-boolean? ~x) (if ~x ~y ~z) (throw (Exception. (cl/str ~x " is not a boolean."))))))
(cl/defmacro kl_if [ & params ] `(if ~@params))

;; normally and and or should also check, if the arguments are boolean.
;; this is currently not implemented due to the reasons explained for if.
(cl/defmacro and
  ([x] `(fn [y#] (cl/and ~x y#)))
  ([x & xs] `(cl/and ~x ~@xs)))

(cl/defmacro or
  ([x] `(fn [y#] (cl/or ~x y#)))
  ([x & xs] `(cl/or ~x ~@xs)))

; (cl/defmacro and
  ; ([] true)
  ; ([x] `(if (clj-boolean? ~x) ~x (throw (Exception. (cl/str ~x " is not a boolean.")))))
  ; ([x & next]
    ; `(if (clj-boolean? ~x) 
		; (if ~x (and ~@next) false)
		; (throw (Exception. (cl/str ~x " is not a boolean."))))))
		
; (cl/defmacro or
	; ([] nil)
	; ([x] `(if (clj-boolean? ~x) ~x (throw (Exception. (cl/str ~x " is not a boolean.")))))
	; ([x & next]
		; `(if (clj-boolean? ~x) 
			; (if ~x true (or ~@next))
			; (throw (Exception. (cl/str ~x " is not a boolean."))))))


; Shen/Kl: (cond (expr1 expr2) (expr3 expr4) ...)
; Clojure: (cond  expr1 expr2   expr3 expr4  ...)
; Normally cond should throw an exception if no condition is met. This is not implemented yet.
(cl/defmacro cond [ & cases]
	`(cl/cond ~@(cl/apply cl/concat cases)))

;;; Symbols (2)
;; corresponds to symbol in Clojure
(cl/defmacro intern [s] 
         `(cl/let [s# ~s] 
                  (cl/condp cl/= s#
                            "true" true
                            "false" false
                            "/" (cl/symbol "/")
                            "/." (cl/symbol "/.")
                            (cl/symbol (string/replace s# "/" "_slash_")))))
  
;; function evaluates a symbol to the assigned function
(cl/defmacro function [x] 
	(if (cl/fn? x) 
		x
	 (throw (RuntimeException. (cl/str "undefined function " x)))))

;;; Strings (5) --DONE--
;; receives the nth unitstring of x
(cl/defmacro pos [x n] `(cl/subs ~x ~n (cl/inc ~n)))
;; returns the parameter string without the first character
(cl/defmacro tlstr [x] `(cl/subs ~x 1))
;; concatenates to strings
(cl/defmacro cn [str1 str2] `(cl/str ~str1 ~str2))

;; In Shen only atoms can be converted to strings, everything that is not a collection is an atom.
(cl/defmacro str [x]
  `(if (cl/not (cl/coll? ~x)) 
	(cl/str ~x)
	(throw (Exception.
          (cl/str ~x " is not an atom; str cannot convert it to a string.")))))
;; checks if the argument is a string
(cl/defmacro string? [x] `(cl/string? ~x))
;; takes an integer and returns the corresponding ascii character
(cl/defmacro n->string [x] `(cl/str (cl/char ~x)))
;; takes a string and returns the ascii value of its first character
(cl/defmacro string->n [x] `(cl/int (cl/first ~x)))

				

;;; Error Handling (3)
;; throws an simple exception
(cl/defmacro simple-error [s] `(throw (RuntimeException. ~s)))
;; trap-error is similar to try in Clojure.
;; the first parameter is the form that possibly throws an exception.
;; the second parameter is a lambda function which receives the thrown exception as parameter.
(cl/defmacro trap-error [x y] `(try ~x (catch Exception e# (~y e#))))
;; returns the message of an Exception/Throwable
(cl/defmacro error-to-string [e] 
	`(if (cl/instance? Throwable ~e)
		(.getMessage ~e)
		(throw (IllegalArgumentException. (cl/str ~e " is not an exception.")))))


;;; Lists (4) --DONE--
;; checks if the argument is a list, but not the empty list
(cl/defmacro cons? [x] `(cl/and (cl/coll? ~x) (cl/not (cl/empty? ~x))))
  
;; adds the first argument to the second argument.
;; if the second argument is a list, the first argument is inserted at the beginning of the list
;; otherwise a list with the two arguments (called Pair in Shen) is created.
(cl/defmacro cons [x y]
	`(cl/let [x# ~x
           y# ~y]
          (if (cl/coll? y#) (cl/cons x# y#) [x# y#])))

(cl/defmacro hd [x] `(cl/first ~x))
(cl/defmacro tl [x] `(cl/vec (cl/rest ~x)))

;;; Generic Functions
;; The postfix __fnPoF__ here is chosen because of the dual namespace behaviour of Shen.
;; by assigning the symbol to itself and the function to the postfixed symbol, we mimic this behaviour.
;; see set, value, function
(cl/defmacro defsource
  "Similar to clojure.core/defn, but saves the function's definition in the var's
   :source meta-data."
  {:arglists (:arglists (cl/meta (var cl/defn)))}
  [fn-name & defn-stuff]
  `(do (cl/defn ~fn-name ~@defn-stuff)
       (cl/alter-meta! (var ~fn-name) cl/assoc :source (quote ~&form))
       (var ~fn-name)))

;(cl/defmacro rec 
;  [f forms] `(do (cl/println ~f) (walk/postwalk (fn [x#] (if (cl/and (cl/seq? x#) (cl/= ~f (cl/first x#))) (cl/cons 'recur (cl/rest x#)) x#)) ~forms)))

(cl/defmacro defun [f params & code] 
	(cl/let [f# (if (cl/seq? f) (cl/eval f) f)]
	`(do
		(defsource ^:dynamic ~f#
			~@(cl/for [p# (cl/map #(cl/take % params) (cl/range 1 (cl/count params)))] 
				`([~@p#] (cl/partial ~f# ~@p#)))
			([~@params] ~@code));(rec f# code))) 
		'~f#)))

(cl/defmacro lambda [x y] `(cl/fn [~x] ~y))

(cl/defmacro let [X Y Z]
  (cl/let [X-safe (if (cl/seq? X) (cl/gensym (cl/eval X)) (cl/gensym X))
             Z (walk/postwalk
                             #(if (cl/= X %) X-safe %) Z)]
          
            `(cl/let [~X-safe ~Y]
                    ; (if (.equals (cl/str ~X) "Parse_<atom>") (cl/println '~X-safe))
                     ~Z)))


(cl/defmacro shen.primitives/= [x y] 
             `(cl/let [x# ~x
                       y# ~y]
                      (if (cl/and (number? x#) (number? y#)) 
                        (cl/== x# y#) 
                        (cl/= x# y#))))

(cl/defmacro freeze [z] `(cl/fn [] ~z)) ; see "Porting Shen"
(cl/defmacro type [x t] `(cl/cast ~t ~x))

;; "pre-evaluation" => simulates Shens evaluation strategy
(cl/declare ewm)
(cl/declare kl-to-clj)

(cl/defmacro pre-eval-without-macros 
	[expr] 
	;; if the argument is a sequence split it into the cl/first element and the rest
	(if (cl/and (cl/seq? expr) (cl/not (cl/empty? expr)))
   (cl/let [f (cl/first expr) r (cl/rest expr)]
           ;; check if the cl/first element is a symbol
           (if (cl/symbol? f)
             ;; if it is a symbol, is it also resolvable?
             (if (cl/resolve f)
               ;; is it a macro or a partial application (created with defun)?
               (if (cl/boolean (try (:macro (cl/meta (cl/eval `(var ~f)))) (catch Exception e false)))
                 ;; then just execute the macro/partial function on the "pre-compiled" rest
                 ;; since macros and partial functions are not in the dual namespace
                 `(cl/cons '~f (ewm ~r))
                 ;; else execute the function
                 `(cl/cons ~f (ewm ~r)))
               ;; if the first element is not resolvable, define it as itself, then use it as a function
               ;; pre-compile the rest
               (do (cl/eval `(def ~f '~f)) `(cl/cons ~f (ewm ~r))))
             ;; if the cl/first element is not a symbol, it is no valid Shen code, throw an error
             (if (cl/and (cl/seq? f) (cl/not (cl/empty? f)))
               `(cl/cons (pre-eval-without-macros ~f) (ewm ~r))
               (if (clj-boolean? f)
                 `(cl/cons '~f (ewm ~r))
                 `(cl/cons 'throw (cl/list (cl/list 'IllegalArgumentException. (cl/str "undefined function " ~f))))))))
   ;; if the argument not a sequence, check if it is a symbol
   (if (cl/symbol? expr)
     ;; if the symbol is not declared yet define it as itself.
     (if (cl/resolve expr)
       (if (try (:macro (cl/meta (cl/eval `(var ~expr)))) (catch Exception e false))
         `(do (cl/println '~expr) (quote '~expr))
         `(if (cl/re-find #"java.lang." (cl/str '~expr))
            (cl/str '~expr)
            '~expr))
       (do (cl/eval `(def ~(cl/with-meta expr {:dynamic true}) '~expr)) expr))
     ;; if the argument is not a symbol, just return the argument
     expr)))
		
;; recursive help function for "pre-evaluation"
;; it evaluates every element of the form, that is not the first element
(cl/defmacro ewm [x] 
		(if (cl/empty? x) 
			x
			(cl/let [[f & r] x]
				(if r
					`(cl/cons (pre-eval-without-macros ~f) (ewm ~r))
					`(cl/list (pre-eval-without-macros ~f))))))
							
(def ^:private missing-symbol-pattern #"Unable to resolve symbol: (.+) in this context")

(cl/defn ^:private missing-symbol [s]
  (cl/when-let [[_ sym] (cl/re-find missing-symbol-pattern (or s ""))] sym))

(cl/defn ^:private fn-to-symbol [fn]
  (cl/-> fn cl/class .getName
      (string/replace "_" "-")
      (string/split #"\$")
      cl/last cl/symbol))

(cl/defn ^:private cleanup-return [x]
  (or (cl/when (cl/fn? x)
        (cl/let [name (fn-to-symbol x)]
                  (cl/when (cl/fn? name) name)))
      x))

(cl/defn ^:private eval-and-declare-missing [kl]
         (try
           (cleanup-return (cl/eval kl))
           (catch RuntimeException e
             (cl/if-let [s (missing-symbol (.getMessage e))]
               (do
                 (set (cl/symbol s) nil)
                 (eval-and-declare-missing kl))
               (throw e)))))


;; eval-without-macros evaluates the pre-evaluated form
(cl/defn eval-without-macros [expr] (cl/eval (pre-eval-without-macros expr)))
(cl/defmacro kl-to-clj [expr] `(cl/eval (pre-eval-without-macros '~expr)))
			
;;; Vectors (4) --DONE--
;; since vectors are mutable in Shen, we needed a way to do that.
;; Atoms where the appropriate choice here, since in contrast to transients, the output 
;; is still human readable. 
(def fail! 'fail!)
(defun fail () fail!)
(cl/defmacro absvector [n] `(cl/atom (cl/vec (cl/take ~n
                              (cl/repeat (fail))))))
(cl/defmacro address-> [v i val] `(cl/atom (cl/swap! ~v cl/assoc ~i ~val)))
(cl/defmacro shen.primitives/<-address [vect n] `(cl/nth @~vect ~n))
(cl/defmacro absvector? [x] `(cl/= (cl/type ~x) clojure.lang.Atom))

;;; Streams (4)
;; for streams we used clojure.java.io functions.
(cl/defmacro pr [v s] 
	`(cl/binding [*out* (if (cl/= (cl/type ~s) clojure.lang.LineNumberingPushbackReader) *out* ~s)]
		(.write *out* ~v) 
		(.flush *out*)
		~v))
(cl/defmacro read-byte [s] `(.read ~s) )
(cl/defmacro open [t p d]
	(if (cl/= t 'file) 
		(if (cl/= d 'in) 
			`(io/reader ~p)
			(if (cl/= d 'out) 
				`(io/writer ~p)
				`(throw (Exception. (cl/str "invalid direction: " '~d)))))
		`(throw (Exception. (cl/str "invalid stream type: " '~t)))))
(cl/defmacro close [s] `(.close ~s))

;;; Time (1) --DONE--
;; Since "It is optional to set this function to record not real time, but run time" [Marc Tarver: Shen doc 3.0, 2011],
;; we chose to implement real, run and date as possible arguments
(cl/declare internal-start-time)
(cl/defmacro get-time [ u ] 
	(if (cl/= u 'real) `(. java.lang.System currentTimeMillis)
		(if (cl/= u 'date) `(.toString (new java.util.Date))
			(if (cl/= u 'run)
				`(cl/* 1.0 (clojure.core// (clojure.core/- (System/currentTimeMillis) internal-start-time) 1000))
		`(throw (IllegalArgumentException. (cl/str "get-time does not understand the parameter " '~u)))))))
	
;;; Arithmetic (9) --DONE--
;; in the documentation it is not defined how many arguments the arithmetic functions are allowed to receive
;; for every arithmetic function 2 arguments are supplied
(cl/defmacro shen.primitives/+ ([x] `(cl/partial cl/+' ~x))
			  ([x y] `(cl/+' ~x ~y)))
(cl/defmacro shen.primitives/- ([x] `(cl/partial cl/-' x))
			  ([x y] `(cl/-' ~x ~y)))
(cl/defmacro shen.primitives/* ([x] `(cl/partial cl/*' ~x))
			  ([x y] `(cl/*' ~x ~y)))
(cl/defmacro /  ([x] `(cl/partial clojure.core// ~x))
			([x y] `(if (cl/== ~y 0) 
						(throw (ArithmeticException. "Divide by zero")) 
						(clojure.core// (cl/double ~x) (cl/double ~y)))))
(cl/defmacro _slash_ [ & args ] `(/ ~@args))
(cl/defmacro shen.primitives/> [x y]  `(cl/> ~x ~y))
(cl/defmacro shen.primitives/< [x y]  `(cl/< ~x ~y))
(cl/defmacro shen.primitives/>= [x y] `(cl/>= ~x ~y))
(cl/defmacro shen.primitives/<= [x y] `(cl/<= ~x ~y))
(cl/defmacro number? [x] `(cl/number? ~x))

;;; Metadata/External Global Variables
(def cd (. (java.io.File. ".") getCanonicalPath))
(set *language* "Clojure")
(set *implementation* (cl/str "Clojure " (cl/clojure-version)))
(set *port* "1.0")
(set *porters* "Dominikus Herzberg, Dominik Greibl, Philip Brosinsky")
(set *version* "version 3.0")
(set *home-directory* cd)
(set *printer* ())
(set *stinput* *in*)
(set *maximum-print-sequence-size* 20)
(set *macros* ())


;;; Shen execute commands
;; executes the shen commands from the forms given
;; and prints the results as well as the given forms.
(cl/defmacro run-shen-commands [[x & r]] 
	(if (cl/not (cl/empty? r)) 
		`(do (cl/println (cl/str "shen# " '~x))
			 (cl/println (kl-to-clj ~x))
			 (run-shen-commands ~r))
		`(do (cl/println (cl/str "shen# " '~x))
			 (kl-to-clj ~x))))

;; replaces all occurrences of "unpleasant symbols"
;; by symbols that can be used in Clojure
(def special-form-replacement-rules 
	 (cl/re-pattern (cl/str "\\b("
                         (string/join "|" ["def" "if" "do" "var" 
                                           "fn" "loop" "recur" 
                                           "throw" "try" 
                                           "monitor-enter" "monitor-exit"])
                         ")\\b")))
	 
(def cleanup-symbols-pattern
  (cl/re-pattern (cl/str "(\\s+|\\()("
                   (string/join "|" (cl/map #(Pattern/quote %) [":" ";" "{" "}" ":-" ":="
                                                             "/." 
                                                             "shen-i/o-macro"
                                                             "shen-put/get-macro"
                                                             "XV/Y"]))
                   ")(\\s*\\)|\\s+?)"
                   "(?!~)")))

(cl/defn replaceall
  [kl] (string/replace 
		(string/replace  
		 (string/replace 
		  kl 
		  cleanup-symbols-pattern "$1(intern \"$2\")$3") 
		 special-form-replacement-rules "kl_$1")
		 "@" "__at__"))
	
;; runs a Shen file
(cl/defn run-shen 
	[fileName] 
		(cl/with-open [rdr (io/reader fileName)]
			(cl/let [file (cl/read-string (cl/str "(" (replaceall (cl/slurp rdr))  ")"))]
				(cl/eval `(run-shen-commands ~file)))))

						
(def kl-files ["sys.kl" "writer.kl" "declarations.kl" 
				"core.kl" "load.kl" "macros.kl" "prolog.kl" 
				"reader.kl" 
				"sequent.kl" "toplevel.kl" "track.kl" "t-star.kl" 
				"printer.kl" "yacc.kl" "types.kl"
				])

(def outstream (open file "log.txt" out))
				
 (cl/binding [*out* outstream]
	(run-shen "sys.kl")
	(run-shen "writer.kl")
	(run-shen "core.kl")
	(run-shen "declarations.kl"))

(cl/binding [*out* outstream]
	(run-shen "load.kl")
	(run-shen "macros.kl")
	;(run-shen "prolog.kl")
	(run-shen "reader.kl")
	(run-shen "sequent.kl")
	(run-shen "toplevel.kl")
	(run-shen "track.kl")
	;(run-shen "t-star.kl")
	(run-shen "printer.kl")
	(run-shen "yacc.kl")
	; (run-shen "types.kl")
	(close *out*))


; overwriting shen/kl functions
(defun shen-reverse_help (V829 V830)
 (cond ((= () V829) V830)
  ((cons? V829) (recur (tl V829) (cons (hd V829) V830)))
  (true (shen-sys-error shen-reverse_help))))
    
(defun shen-compose (V511 V512)
    (cond ((= () V511) V512)
     ((cons? V511) (shen-compose (tl V511) ((cl/eval (hd V511)) V512)))
     (true (shen-sys-error shen-compose))))

(defun compile (V645 V646 V647)
 (let O (V645 (__at__p V646 ()))
  (if (or (= (fail) O) (not (empty? (fst O)))) (shen-compile-error O V647)
   (kl-to-clj (snd O)))))
	
(defun arity (V1495)
  (cl/let [V1495 (if (cl/seq? V1495) 
                   (cl/eval V1495) 
                    (if (cl/and (cl/symbol? V1495) (cl/fn? V1495))
                      (cl/eval V1495)
                      V1495))] 
          (trap-error (get V1495 arity (value shen-*property-vector*)) (lambda E -1))))


(cl/defmacro define [name & body]
  `(eval (shen-shen->kl '~name '~body)))

(try (clojure.java.io/delete-file "log.txt") (catch Exception E nil))

(def internal-start-time (System/currentTimeMillis))
(shen-shen)